perm filename INTERP.F4[3,ALS] blob
sn#041473 filedate 1973-05-13 generic text, type T, neo UTF8
implicit double precision (a-h,o-z)
dimension x(30),f(30)
1 type 400
accept 401,npts
if (npts) 999,999,30
30 type 402
do 50 i=1,npts
50 accept 403,x(i),f(i)
type 404
accept 401,mode
type 406
accept 407,xwant
do 100 i1=1,npts-1
xi=x(i1)
dif=xwant-xi
fi=f(i1)
save1=f(i1+1)
do 200 j1=i1+1,npts
200 f(j1)=fi+dif*(f(j1)-fi)/(x(j1)-xi)
if (mode) 220,100,100
220 do 150 k=i1+1,npts
150 type 500,f(k)
type 501
100 continue
type 502,f(npts)
type 501
goto 1
999 stop
400 format(' number of points='$)
401 format(i)
402 format(' input x,f(x):'/)
403 format(2d)
404 format(' mode='$)
406 format(' want f(x) at x='$)
407 format(d)
500 format(1x,d)
501 format('-')
502 format(' f(x)=',1pd20.10)
end